home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 027a / sg202.zip / SCROLGET.PRG < prev   
Text File  |  1991-08-18  |  36KB  |  978 lines
  1. /*
  2. Version 2.02 of 18.08.91, 22:20 MEZ (Central European Standard Time)
  3.  
  4. This is a greatly improved version of a program wich has been spread
  5. as scrolget.zip (.arj etc) thru BBS
  6.  
  7. This new version isn't backward compatible. But you cann now incorporate
  8. it directly within your programs. Just use the Virtualget Command
  9. to define your gets and the scrolread() function to read them.
  10. While using scrollread, all parameters except the first one (containing
  11. the vGetlist) are optional.
  12. Scrolread() now cann replace 95 % of the cases you usualy would 
  13. use readmodal() or the read command
  14.  
  15. Revision History :
  16. 15.08.91
  17. - corrected some small typos within the documentation text
  18. - added some more documentation here and there (i.e. see Caveats)
  19. - added enviroment saving and restoring within scrollread()
  20. 18.08.91  - Big improvments :
  21. - The color-Bug of the previous version has been sorted out
  22. - The Custom readerblock of the getobject is now processed,
  23.   if there is any
  24. - Now PgDn and PgDn work as expected : They scroll a Page forward
  25.   respective backwards
  26.   Ctrl-Pgup will now get you to the first page, Ctrl-PgDn to the last one..
  27. - Calculating new Getrows now allways depends on the Cargo-Value and not on
  28.   the actual Rows in Get:Row instance variable. This was changed, as
  29.   it seems that the Get:Row-Instance variable cann't have any negative
  30.   value (it's appearently converted to 65535 - Value)
  31. - The scrolling-Logic  should now also manage very strange situations,
  32.   where you have very wild get ordering, one on the first page, the next
  33.   one on the 4th page, the next one on the second etc
  34. - changed left() to padr() in Showbg to successfully clear the line
  35.   when a line of the background array is shorter then the screen width
  36. - added table of contents at the end of the documentation part
  37. - documented how to use Get-Background and why I implemented it this way
  38. - changed Prevalidate() and Postvalidate() functions to static, so that
  39.   they don't interfere with the functions of the same name within
  40.   clipper's getsys.prg
  41. 18.08.91, 21:00
  42. - changed calling conventions of scrolget to four boxcoordinates rather
  43.   than boxheigth and boxwidth (I'm more accustomed to this mode from
  44.   the other clipper functions).
  45. - new Parameter "mode" : if you pass an "V" like View, it will display the
  46.   box with the getfields only and then exit immidiatly
  47. - The useless calls to the InfoBox-Functions have been thrown out..
  48. - more documentation on the new features
  49.  
  50. This program shows how to do scrolling gets in Clipper 5.01
  51. It will also scroll the Background with it .....
  52. So you are able to edit forms of some pages within a 10 Lines Box..
  53.  
  54. This version only implements vertical scrolling
  55.  
  56. The getsystem is based on a template I made out of
  57. "WEIRDGETS.PRG/Funcs.ch" a beautiful demo of the Clipper 5 Getsystem
  58. done by The People from Nantucket Canada..
  59. I understand they placed it into Public Domain...
  60. It's also based on a readsystem I wrote for Clipper S'87 to implement
  61. when clauses, scrolling gets and other things in that Clipper Version...
  62. The GetPreValidate and GetPostValidate functions are shortcuts of the
  63. same functions found in Getsys.prg provided by Nantucket.
  64.  
  65. I only changed it in a way that it will do scrolling gets and I throwed
  66. out all non scrolling related features...
  67. The Code is extremly documented, there is much more documentation than code.
  68. I hope this will make it easy for you to implement it within your own
  69. programs.
  70.  
  71. The original Version, wich just scrolled gets (The first Program
  72. available via BBS to do so, as far as I know), is the result of
  73. some two days of typing and was done in July 1991 by Kai Froeb
  74. (Kai is pronounced like ki (i in like))
  75.  
  76. I'm a 27 years old Clipper Programmer,
  77. living in Schumanstr.8, W-8500 Nürnberg 80, Germany
  78. Tel : 0049-911-316838
  79. FidoNet : 2:246/16.6
  80. Internet : k.froeb@msn.rmi.de
  81.  
  82. I'd loved to be contacted by other Clipper Programmers....
  83. Especialy I'd like to see any enhancements you made out of this...
  84.  
  85. You may freely use and modify the source. If you're developing libraries,
  86. you can also incorporate a version of this program in your library.
  87. I'd like seeing you giving me some credits for this,
  88. but there's no need if you don't want to..
  89.  
  90. Caveats :
  91. - Demo will only look nice on ega/Vga screens due to blinking colors..
  92. - My Valid and Whenclause processing doesn't update the update variable,
  93.   calls to update()-Function will therefore be useless. Also, the
  94.   IMHO idiotic Scoreboard()-Function has been thrown out...
  95. - No range Clause provided
  96. - scrollread() uses F10 as Save&Exit Key, it saves and restores the original
  97.   F10 setting, but within scrolget, F10 has this special effect.
  98.   comment it out if you don't like that or feel free to change it to
  99.   another key
  100. - scrollread() uses the Cargo-Instancevariable of the Getobjects
  101.   for the actual implementation of the virtual Getrows and -columns
  102.   IF you're using The Cargo-Variable allready, search with your texteditor
  103.   for cargo[CARGO_ROW] and cargo[CARGO_COL] and replace the Index
  104.   with other (probably higher) numbers..
  105. - Pay attention that scrollread uses rows and columns,
  106.   calculated RELATIVE to the boxborder, in a way that they start
  107.   from the begining of the box(window).
  108.   I.E., if you have a box placed at @ 4,5 and therein a get
  109.   wich you define to be located at @ 1,1, this get field will
  110.   appear at absolute @ 4+1,5+1 = @ 5,6
  111. - TimeToExit() (Last Function in this file) asks the user if sHe wants
  112.   to save/abort. Non-English Programs should have a modified version
  113.   of this Function, as it's in english (fortunatly, it's the only
  114.   language dependant part herein). You also may wish to use your
  115.   own boxing/Questioning Routines with that function..
  116. - When defining a Background, this Background should not exceed
  117.   the highest Getrow by a Boxheigth 
  118.   (i.e. : if your boxheigth is 10 and your highest virtual getrow is 30, 
  119.   your Background mustn't have more then 39 lines),
  120.   otherwise you might get problems with the PgUp/PgDn key combinations
  121. - When Using the virtualget Command, be carrefull when using it with
  122.   Arrays. If you have a for next loop like this :
  123.   for nKounter := 1 to 10
  124.      @ nKounter , nOffset virtualget aValue[nKounter]
  125.   next
  126.   You run into problems, as the Preprocessor will turn aValue[nKounter]
  127.   into a Codeblock with a reference to nKounter. So, when you try to
  128.   scrollread it, eval will 10 times find aValue[11] (11 is the assumed
  129.   value after leaving the for next loop)
  130.  
  131.   Better define gets for Arrays directly e.g. :
  132.   #define lstr(x) ltrim(str(x))
  133.   for nKounter = 1 to 10
  134.       aadd(vGetlist,GetNew( nKounter, nOffset,;
  135.         &("{|NewValue|iif(NewValue=NIL,aValues["+lstr(nKounter)+"],";
  136.         aValues["+lstr(nKounter)+"]:=NewValue)}"),:
  137.         aValues["+lstr(nKounter)+"]")
  138.   next
  139.  
  140.  
  141. Known Bugs :
  142.  - None :-))
  143.  
  144. Compile with clipper scrolget /A /B /N /M /W
  145. (minimum is /N)
  146.  
  147. Link with rtlink fi scrolget or blinker fi scrolget
  148.  
  149.  
  150. The program consists of the following UDFs :
  151.  
  152. * DemoScroll  - Demo for Scrolling Gets
  153. * scrollread  - The Scrolling-Get engine (sort of replace for Readmodal)
  154. * FirstGetinBox - Find the Number of the Get in the upper left corner
  155. * MaxGetrow   - Find the Number of the Get with the highest Virtual Line Number
  156. * ScrollNext  - Calculate new rows when Scrolling to the next get
  157. * ShowGetBG   - Display the Getbackground (Titles etc) wich fits in the box
  158. * NewGetRows  - Reset the row values in the Getobject to new values
  159. * NewGetCols  - Reset the column values in the Getobject to new values
  160. * ShowGets    - Display the Gets wich fit in the box
  161. * GetFocus    - activate / deactivate a Get
  162. * GetPreValidate  - check When Clause of Get
  163. * GetPostValidate - check Valid clause of Get
  164. * Shad        - Draw a shadowed Box
  165. * TimeToExit  - Popup Box to ask the user if sHe realy wants to exit
  166.  
  167. */
  168.  
  169. // Symbolic Names for Inkey-values
  170. #include "inkey.ch"
  171. // funcs.ch came from Nantucket Canada. I just took out the parts
  172. // needed for this demo..
  173. #include "funcs.ch"
  174.  
  175. // first element in Cargo Array of getelements indicates virtual row
  176. #define CARGO_ROW 1
  177. // second element in Cargo Array of getelements indicates virtual column
  178. #define CARGO_COL 2
  179.  
  180. // With the default Get command, the gets are displayed the same time
  181. // they are defined. This is not what I want here. I just want to define the
  182. // gets, but display them later. That's exactly what my alternative
  183. // implementation of the Get command, Virtualget, does (it only defines them)
  184.  
  185. // You may use this command to define your own getobjects as well,
  186. // it is a stand alone command. Only take attention, that this
  187. // Command uses the variable vGetlist rather then Getlist,
  188. // What you cann change of course, if you like...
  189.  
  190. // You also may change it's name Virtualget to Vget, what's less
  191. // work to write in full length...
  192.  
  193. // Using xcommand means, that you can't abriviate the command by 4 letters
  194. // I'm using xcommands for my preprocessor Commands, as I found it rather
  195. // difficult to watch for not using possible abriviatons of my so defined
  196. // commands by chance..
  197.  
  198. #xcommand @ <row>, <col> VIRTUALGET <var>                               ;
  199.                         [PICTURE <pic>]                                 ;
  200.                         [VALID <valid>]                                 ;
  201.                         [WHEN <when>]                                   ;
  202.                         [COLOR <color>]                                 ;
  203.                         [SEND <msg>]                                    ;
  204.                                                                         ;
  205.       => iif(vGetlist=NIL,vGetlist:={},NIL)                             ;
  206.          ;AAdd(                                                         ;
  207.             vGetlist,                                                   ;
  208.             GetNew( <row>,<col>,                                        ;
  209.                    {|NewValue|iif(NewValue=NIL,<var>,<var>:=NewValue)}, ;
  210.                    <(var)>, <(pic)>, <(color)>)                         ;
  211.              )                                                          ;
  212.       [; ATail(vGetlist):PostBlock := <{valid}>]                        ;
  213.       [; ATail(vGetlist):PreBlock  :=  <{when}>]                        ;
  214.       [; ATail(vGetlist):<msg>]
  215.  
  216.  
  217. function DemoScroll()
  218. /*****************************************
  219. 0     1════════╗ <--- Background
  220. 1     2        ║
  221. 2  1──3────────╫────┐ Boxtop =2
  222. 3  2  4BGTOP=4 ║    │<------- Box (Window)
  223. 4  3  5        ║    │  Boxh  =5
  224. 5  4  6BGbot=6 ║    │
  225. 6  5──7────────╫────┘ Boxbot =6
  226. 7     8════════╝ BGh =8
  227. ******************************************/
  228. local Boxtop := 2  // Boxtop
  229. local Boxh   := 11 // Boxheigth
  230. local Boxleft:= 5  // Boxleft
  231. local Boxw   := 66 // Boxwidth
  232. local GetBG  := {} // Get-Background
  233. local BGtop  := 1  // first Line of Get-Background displayed within Box
  234. local BGh          // Get-Background consists of how many lines ?
  235. local BGColor := "BG/B" // Color of Get-Background
  236.                         // also used as color of the Getbox itself
  237.  
  238. local vGetlist := {} // The Getlist..
  239.  
  240. local nKounter     // for a for-Next-Loop
  241.  
  242. local cDefcol      // for Panel() (see funs.ch)
  243.  
  244. local cGetNo_1 , cGetNo_2 , cGetNo_3 , cGetNo_4 ,;
  245. cGetNo_5 , cGetNo_6 , cGetNo_7 , cGetNo_8 , cGetNo_9,;
  246. cGetNo_10, cGetNo_11 , cGetNo_12 , cGetNo_13 , cGetNo_14 ,;
  247. cGetNo_15 , cGetNo_16 , cGetNo_17 , cGetNo_18 , cGetNo_19
  248.  
  249. // Here I'm defining some sample Getvalues, so that you can easyly
  250. // figure out on wich get you are..
  251. //  Initializes them with 60 spaces
  252. cGetNo_1 := "1"+space(59)
  253. cGetNo_2 := "2"+space(59)
  254. cGetNo_3 := "3"+space(59)
  255. cGetNo_4 := "4"+space(59)
  256. cGetNo_5 := "5"+space(59)
  257. cGetNo_6 := "6"+space(59)
  258. cGetNo_7 := "7"+space(59)
  259. cGetNo_8 := "8"+space(59)
  260. cGetNo_9 := "9"+space(59)
  261. cGetNo_10 := "10"+space(58)
  262. cGetNo_11 := "11"+space(58)
  263. cGetNo_12 := "12"+space(58)
  264. cGetNo_13 := "13"+space(58)
  265. cGetNo_14 := "14"+space(58)
  266. cGetNo_15 := "15"+space(58)
  267. cGetNo_16 := "16"+space(58)
  268. cGetNo_17 := "17"+space(58)
  269. cGetNo_18 := "18"+space(58)
  270. cGetNo_19 := "19"+space(58)
  271.  
  272.  
  273. // The colors the Nantucket People choosed look neat,
  274. // but make only sense on an ega or vga monitor,
  275. // where you cann hilite colors instead of blinking attribute..
  276. SETBLINK( .F. )
  277.  
  278. // Just some screen setup.. (see funs.ch)
  279. Panel(.t.)
  280.  
  281. // Define your Gets with scrollread for your convenience..
  282. // If you want to test the clauses, just take away the //s below
  283. // or try your own ones..
  284. @  1,3 virtualget cGetNo_1 color 'w+/rb, w+/r' // valid ! empty(cGetNo_1)
  285. @  3,3 virtualget cGetNo_2 color 'w+/rb, w+/b'
  286. @  5,3 virtualget cGetNo_3 color 'w+/rb, w+/gr' // when ! "e" $ cGetNo_3
  287. @  7,3 virtualget cGetNo_4 color 'w+/rb, w+/bg'
  288. @  9,3 virtualget cGetNo_5 color 'w+/rb, w+/N'  // picture "@!"
  289. @ 11,3 virtualget cGetNo_6 color 'w+/rb, w+/b+'
  290. @ 13,3 virtualget cGetNo_7 color 'w+/rb, w+/g'
  291. @ 15,3 virtualget cGetNo_8 color 'w+/rb, w+/B*'
  292. @ 17,3 virtualget cGetNo_9 color 'w+/rb, w+/r+'
  293. @ 19,3 virtualget cGetNo_10 color 'w+/rb, w+/b+'
  294. @ 21,3 virtualget cGetNo_11 color 'w+/rb, w+/r' // valid ! empty(cGetNo_1)
  295. @ 23,3 virtualget cGetNo_12 color 'w+/rb, w+/b'
  296. @ 25,3 virtualget cGetNo_13 color 'w+/rb, w+/gr' // when ! "e" $ cGetNo_3
  297. @ 27,3 virtualget cGetNo_14 color 'w+/rb, w+/bg'
  298. @ 29,3 virtualget cGetNo_15 color 'w+/rb, w+/N'  // picture "@!"
  299. @ 31,3 virtualget cGetNo_16 color 'w+/rb, w+/b+'
  300. @ 33,3 virtualget cGetNo_17 color 'w+/rb, w+/g'
  301. @ 35,3 virtualget cGetNo_18 color 'w+/rb, w+/B*'
  302. @ 37,3 virtualget cGetNo_19 color 'w+/rb, w+/r+'
  303.  
  304. // This version assumes you have a Background within the getbox, e.g.
  305. // for Get-Titles and other things. This Background is implemented in form
  306. // of an Array, where every line of the background corresponds to one
  307. // element in the array. So you'll have to declare this array. It should
  308. // have minimum as much lines as the higest value for the getrows
  309. // e.g. if you have a
  310. // @ 250, 3 virtualget cTest
  311. // in your program, the background has to be an array of minimum
  312. // 250 Elements. They all need to be of type Characters
  313. // (fill with "", if you don't use them)
  314. //
  315. // Why implement the Background like this ?
  316. // - Better a Background then Fieldtitles only, so that one has
  317. //   more options (i.e. this way, you can include boxes etc )
  318. // - Better realize it as array then as a string, as :
  319. //   a) it's much faster to grab the lines with GetBg[LineNumber] then 
  320. //      grabbing it thru memoline, what is very slow (and a string with 
  321. //      fixed linelength on the other hand takes much too much memory).
  322. //   b) displaying with aeval-Function (see ShowBg()) is much faster 
  323. //      then a for next loop
  324. //   c) When you use scrollread() in a  generic routine, wich automaticaly
  325. //      calculates the Getscreens, so that one get is placed beyond the
  326. //      other, row by row and you have an array of fieldtitles available,
  327. //      you could pass this array will do very well as background.
  328. //      Also, if you don't have an array of fieldtitles, an Array with 
  329. //      fieldnames will do the job, too.
  330.  
  331. // Fill Dummy Background, every Line with another Letter...
  332. for nKounter :=1 to 37
  333.    aadd(GetBG,replicate(chr(64+nKounter),80))
  334. next
  335.  
  336. // Background will now look like that :
  337. // AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
  338. // BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
  339. // CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  340. // etc
  341.  
  342.  
  343. // The Getarray defined with virtualgets is named vGetlist
  344. if scrollread(vGetlist,GetBg,Boxtop,Boxleft,Boxh,Boxw,BGcolor)
  345.    // User choosed "Save Changes",
  346.    // so place your Replace commands here
  347.    // For the new values, refer to vGetlist, wich, as beeing an array,
  348.    // has been passed to scrollread() via Reference and so now
  349.    // reflects all changes made therein
  350. else
  351.    // User aborted Get
  352.    // Place any command to handle this situation (Warnings or whatever)
  353.    // here
  354. endif
  355.  
  356. return nil
  357.  
  358. *-----------------------------------------------------------------
  359.  
  360. FUNCTION scrollread(aGet,GetBg,Boxtop,Boxleft,Boxbot,Boxright,BGcolor,nGet,bDrawBox,mode)
  361. local cThisGet, lSkiped := .f.
  362. LOCAL nKey := 0, nLastGet, BGh,BGTop,nKounter, Boxh, Boxw
  363. LOCAL lInsert := .T.
  364. local cO_color,nO_cursor,bO_f10key
  365.  
  366. // all Parameters except aGet are optional, so check them
  367.  
  368. if valtype(mode) <>"C"
  369.    mode = "E"
  370. endif
  371. if valtype(Boxtop) <>"N" .and. valtype(Boxleft) <>"N" .and. valtype(bDrawbox) <>"B"
  372.    // No coordinates passed, assume they wish to have it very much
  373.    // compatible to the usual get/read command - so we provide no box
  374.    bDrawBox:={||.t.} // assume no box
  375. endif
  376. if valtype(Boxtop) <>"N"
  377.    Boxtop =0
  378. endif
  379. if valtype(Boxleft) <>"N"
  380.    Boxleft =0
  381. endif
  382. if valtype(Boxbot) <>"N"
  383.    Boxbot = Maxrow()
  384. endif
  385. if valtype(Boxright) <>"N"
  386.    Boxw = Maxcol()
  387. endif
  388. if valtype(BGColor) <>"C"
  389.    BGColor = setcolor()
  390. endif
  391.  
  392. if valtype(nGet) <>"N"
  393.    nGet := 1
  394. endif
  395. if valtype(GetBG) <> "A"
  396.    GetBG := array(aGet[MaxGetRow(aGet)]:Row)
  397.    afill(GetBG,"")
  398. endif
  399.  
  400. Boxh = Boxbot - Boxtop+1
  401. Boxw = Boxright - Boxleft+1
  402.  
  403. BGh := len(GetBg)  // Tell system how many backgroundlines there are
  404.  
  405. BGTOP := max(aGet[nGet]:Row-Boxh+3,1)
  406.  
  407. if valtype(bDrawBox) <> "B"
  408.    //  Draws the GET Frame.. (see UDF below)
  409.    bDrawBox:={||Shad( Boxtop, Boxleft, Boxbot, Boxright , .T., BGcolor )}
  410. endif
  411. // Save the enviroment :
  412. cO_color  := setcolor()
  413. nO_cursor := setcursor()
  414. bO_f10Key := setkey(K_F10,NIL) // free F10-Key, so that we cann use it
  415.  
  416. // nLastget is set to a dummy value (must be same as nGet)
  417. nLastGet := nGet
  418.  
  419. // Save the original Boxrows and Cols..
  420. aeval(aGet,{|oGet|oGet:Cargo := {oGet:Row,oGet:Col}})
  421.  
  422. // Now change the Get-Columns to fit into the box..
  423. // Newgetcols() is a UDF below..
  424. NewGetCols(aGet,Boxleft)
  425.  
  426. // Same with Get-Rows..  (Newgetrows() is a UDF below..)
  427. NewGetRows(aGet,Boxtop,Bgtop)
  428.  
  429. //  Draws the GET Frame.. (see funcs.ch)
  430. eval(bDrawBox)
  431.  
  432. // Draw the Background of the Gets.. (Titles etc)
  433. ShowGetBG(GetBG,Boxtop,Boxleft,Boxw,BGTOP,Boxh-2,BGcolor)
  434.  
  435. // Display those gets which fit into the box :
  436. ShowGets(aGet,nGet,Boxtop,Boxh)
  437.  
  438. //  Positions the cursor to the first position in the first GET
  439. DEVPOS( aGet[nGet]:ROW, aGet[nGet]:COL )
  440.  
  441. // Process Keystrokes in a Loop until the user wants to exit
  442. // Don't enter this Loop, if we're in display-only mode
  443. DO while mode != "V" .and. nKey != K_F10
  444.    lSkiped := .f. // Set within When-Clause processing. Reset to .f. first
  445.  
  446.    do case
  447.       * If the active get doesn't meet the when clause..
  448.       case ! GetPrevalidate(aGet[ nGet ])
  449.          lSkiped = .t. // We skip the valid clause..
  450.          // Whats going on here ?
  451.          // We simulate a keystroke to bypass the actual get
  452.          // we do it directly, not with the keyboard command,
  453.          // for not running into any conflicts with pending keystrokes..
  454.          do case
  455.             * If we can't move upwards
  456.             case nGet <= 1
  457.                nKey = K_DOWN
  458.             * if we can't move downwards
  459.             case nGet >= len(aGet)
  460.                nKey = K_UP
  461.             * if last Key was Cursor up i.e., the current direction is Upwards
  462.             case nKey = K_UP
  463.                * just continue, nothing special to do...
  464.                * nKey = K_UP
  465.             otherwise
  466.                * default is moving downwards..
  467.                nKey = K_DOWN
  468.          endcase
  469.       case ( ValType( aGet[nGet]:reader ) == "B" )
  470.          Eval( aGet[nGet]:reader, aGet[nGet] )  // use custom reader block
  471.          nKey := lastkey()
  472.       otherwise
  473.          SETCURSOR( 1 ) // Cursor on...
  474.  
  475.          nKey := INKEY( 0 ) // Change 0 in inkey(0) to another value
  476.                             // to have gets with time out...
  477.    endcase
  478.  
  479.    DO CASE
  480.       * Process hotkeys
  481.       case valtype(setkey(nkey)) == "B"
  482.          eval(setkey(nkey),"SCROLGET",0,aGet[nGet]:Name)
  483.  
  484.       CASE nKey == K_ENTER .OR. nKey == K_TAB .or. nKey == K_DOWN
  485.          * we're moving down (Tab also moves down, just like in windows)
  486.          nGet++
  487.  
  488.       CASE nKey == K_SH_TAB .or. nKey == K_UP
  489.          * we're moving up (Shift-Tab also moves up, just like in windows)
  490.          iif( nGet == 1, Nil, nGet-- )
  491.  
  492.       CASE nKey == K_BS
  493.          aGet[ nGet ]:BACKSPACE()
  494.  
  495.       CASE nKey == K_DEL
  496.          aGet[ nGet ]:DELETE()
  497.  
  498.       CASE nKey == K_LEFT
  499.          aGet[ nGet ]:LEFT()
  500.  
  501.       CASE nKey == K_RIGHT
  502.          aGet[ nGet ]:RIGHT()
  503.  
  504.       CASE nKey == K_HOME
  505.          aGet[ nGet ]:HOME()
  506.  
  507.       CASE nKey == K_END
  508.          aGet[ nGet ]:END()
  509.  
  510.       CASE nKey == K_CTRL_LEFT
  511.          aGet[ nGet ]:WORDLEFT()
  512.  
  513.       CASE nKey == K_CTRL_RIGHT
  514.          aGet[ nGet ]:WORDRIGHT()
  515.  
  516.       CASE nKey == K_CTRL_HOME
  517.          nGet := 1
  518.  
  519.       CASE nKey == K_CTRL_END
  520.          nGet := LEN( aGet )
  521.  
  522.       CASE nKey == K_CTRL_T
  523.          aGet[ nGet ]:DELWORDRIGHT()
  524.  
  525.       CASE nKey == K_CTRL_Y
  526.          aGet[ nGet ]:DELEND()
  527.  
  528.       CASE nKey == K_CTRL_U
  529.          aGet[ nGet ]:UNDO()
  530.  
  531.       //  Toggles the INSERT mode
  532.       CASE nKey == K_INS
  533.          lInsert := iif( lInsert, .F., .T. )
  534.          // Place your own Statments here to show new Status
  535.          /*
  536.          @12, 64 SAY iif( lInsert, ' INS ', ' OVR ' )
  537.          */
  538.  
  539.       * it's a character to be entered...
  540.       CASE Range( nKey, 32, 160 )  // Non americans still exist out there...
  541.          iif( lInsert, aGet[ nGet ]:INSERT( CHR( nKey ) ),;
  542.          aGet[ nGet ]:OVERSTRIKE( CHR( nKey ) ) )
  543.  
  544.        case nKey = K_PGUP .or. nKey = K_PGDN .or.;
  545.             nKey = K_CTRL_PGUP .or. nKey = K_CTRL_PGDN
  546.           //  dummy - will be processed below
  547.  
  548.       * user wants out...
  549.       CASE nKey == K_F10 .OR. nKey == K_ESC
  550.  
  551.          //  Pop up an Exit dialog box
  552.          nKey := iif( TimeToExit() = 1, K_F10, 0 )
  553.  
  554.    ENDCASE
  555.  
  556.       * we're beyond the last get, so ask the user if sHe wants to exit..
  557.    IF nGet == LEN( aGet ) + 1
  558.       //  Pop up an Exit dialog box
  559.       iif( TimeToExit() == 1, nKey := K_F10, NIL )
  560.       nGet := LEN( aGet )
  561.    ENDIF
  562.  
  563.    //  If the GET has changed, the old GET loses it's focus
  564.    IF nLastGet != nGet .or.;
  565.        nKey = K_PGUP .or. nKey = K_PGDN .or.;
  566.        nKey = K_CTRL_PGUP .or. nKey = K_CTRL_PGDN
  567.       * First Look, if the get meets the Validclause
  568.       if ! lSkiped .and. ! GetPostValidate(aGet[nLastget])
  569.          * if it doesn't don't leave the get, reforce new input..
  570.          nGet = nLastget
  571.          loop
  572.       endif
  573.       // Kill the focus of the last get and set it to unselected Color
  574.       GetFocus( aGet[ nLastGet ], .F.)
  575.  
  576.       /*****************************************
  577.       0     1════════╗
  578.       1     2        ║
  579.       2  1──3────────╫────┐ Boxtop =2
  580.       3  2  4BGTOP=4 ║    │
  581.       4  3  5        ║    │  Boxh  =5
  582.       5  4  6BGbot=6 ║    │
  583.       6  5──7────────╫────┘ Boxbot =6
  584.       7     8════════╝ BGh =8
  585.       ******************************************/
  586.       do case
  587.          * new getrow is outside the window - time to scroll gets..
  588.          case aGet[nGet]:Row <= Boxtop .or. aGet[nGet]:Row >= Boxtop+Boxh-1
  589.             ScrollNext(aGet,nGet,nLastget, Boxtop,Boxh,@BGtop,bgh)
  590.             * Show the new Background...
  591.             ShowGetBG(GetBG,Boxtop,Boxleft,Boxw,BGTOP,Boxh-2,BGcolor)
  592.             * Show the new Gets, set focus to new get
  593.             ShowGets(aGet,nGet,Boxtop,Boxh)
  594.          case nKey = K_PGUP .or. nKey = K_PGDN .or.;
  595.             nKey = K_CTRL_PGUP .or. nKey = K_CTRL_PGDN
  596.             do case
  597.                case nKey == K_PGUP
  598.                   BGTop := max(BGtop-Boxh+2,1)
  599.                case nKey == K_PGDN
  600.                   BGTop := min(BGtop+Boxh-2,BGh-Boxh+3)
  601.                case nKey == K_CTRL_PGUP
  602.                   BGTop = 1
  603.                case nKey == K_CTRL_PGDN
  604.                   BGTop = BGh-Boxh+3
  605.             endcase
  606.             nGet  := FirstGetinBox(aGet,BGTop,Boxh)
  607.             NewGetRows(aGet,Boxtop,Bgtop)
  608.             * Show the new Background...
  609.             ShowGetBG(GetBG,Boxtop,Boxleft,Boxw,BGTOP,Boxh-2,BGcolor)
  610.             * Show the new Gets, set focus to new get
  611.             ShowGets(aGet,nGet,Boxtop,Boxh)
  612.          otherwise
  613.             * set focus to new get
  614.             GetFocus( aGet[ nGet ], .T.)
  615.       endcase
  616.       * Save values
  617.       nLastGet := nGet
  618.    ENDIF
  619.  
  620.    //  Returns the cursor in the current GET
  621.    DEVPOS( aGet[ nGet ]:ROW, aGet[ nGet ]:COL + aGet[ nGet ]:POS - 1 )
  622.  
  623. ENDDO
  624.  
  625. // make sure getfield isn't active any more
  626. // this is especialy important for "V"iew mode
  627. GetFocus( aGet[ nGet ], .f.)
  628.  
  629. // Restore the getlist's original Boxrows
  630. // coment this out, if you want to process the actual Row and Column settings
  631. // within the calling routine..
  632. aeval(aGet,{|oGet|oGet:Row := oGet:cargo[CARGO_ROW], oGet:Col := oGet:cargo[CARGO_COL]})
  633.  
  634. setkey(K_F10,bO_f10key) // restore orignal F10-Key settings
  635. setcursor(nO_cursor)  // restore the cursor
  636. setcolor(cO_color)    // restore the color
  637.  
  638. RETURN nKey != K_ESC // Will return .t. if User wants to save changes,
  639.                      // otherwise will return .f. (User Escaped)
  640.  
  641. // The Bottom of the Box is calculated as Boxtop plus
  642. // Boxheigth -1 (see Grafic above)
  643. // extra step to make the code more readable
  644. // converted to Preprocessor constant for better runtime performance
  645. #define Boxbot (Boxtop+Boxh-1)
  646.  
  647. *-----------------------------------------------------------------
  648.  
  649. function FirstGetinBox(aGet,BGTop,Boxh)
  650. local nKounter, nMin, oGet
  651. nMin := MaxGetRow(aGet)
  652. for nKounter :=1 to len(aGet)
  653.     oGet:=aGet[nKounter]
  654.     if oGet:cargo[CARGO_ROW] >= BGTop .and. oGet:cargo[CARGO_ROW]<=Bgtop+Boxh-2
  655.        if oGet:cargo[CARGO_ROW] < aGet[nMin]:cargo[CARGO_ROW] .or.;
  656.              (oGet:cargo[CARGO_ROW] = aGet[nMin]:cargo[CARGO_ROW] .and.;
  657.               oGet:cargo[CARGO_COL] < aGet[nMin]:cargo[CARGO_COL] )
  658.           nMin :=nKounter
  659.        endif
  660.     endif
  661. next
  662. /*
  663. nKounter :=0
  664. aeval(aGet,{|Get|nKounter++,nMin :=;
  665.        iif(Get:cargo[CARGO_ROW] >= BGTop .and. Get:cargo[CARGO_ROW]<=Bgtop+Boxh-2,;
  666.        iif(Get:cargo[CARGO_ROW] < aGet[nMin]:cargo[CARGO_ROW] .or.;
  667.            (Get:cargo[CARGO_ROW] = aGet[nMin]:cargo[CARGO_ROW] .and.;
  668.             Get:cargo[CARGO_COL] < aGet[nMin]:cargo[CARGO_COL] ),;
  669.             nKounter, nMin),nMin)})
  670.      1     CP   P
  671. aeval(aGet,{|Get|nKounter++,nMin :=;
  672.           2                                                                      I1
  673.        iif(Get:cargo[CARGO_ROW] >= BGTop .and. Get:cargo[CARGO_ROW]<=Bgtop+Boxh-2,;
  674.           3
  675.        iif(Get:cargo[CARGO_ROW] < aGet[nMin]:cargo[CARGO_ROW] .or.;
  676.            4
  677.            (Get:cargo[CARGO_ROW] = aGet[nMin]:cargo[CARGO_ROW] .and.;
  678.                                                                4 I2
  679.             Get:cargo[CARGO_COL] < aGet[nMin]:cargo[CARGO_COL] ) ,;
  680.                     E2    3 E1   2C1
  681.             nKounter, nMin) ,nMin)})
  682. */
  683. return nMin
  684.  
  685. *-----------------------------------------------------------------
  686.  
  687. function MaxGetrow(aGet)
  688. local nMax := 0
  689. local nKounter
  690. if nMax < 1
  691.    nMax := 1
  692.    nKounter :=0
  693.    for nKounter := 1 to len(aGet)
  694.        if aGet[nKounter]:cargo[CARGO_ROW]>aGet[nMax]:cargo[CARGO_ROW]
  695.           nMax := nKounter
  696.       endif
  697.    next
  698.    /*
  699.    nMax := aeval(aGet,{|oGet|nKounter++, ;
  700.                  nMax := iif(oGet:cargo[CARGO_ROW]>aGet[nMax]:cargo[CARGO_ROW], nKounter, nMax)})
  701.    */
  702. endif
  703. return nMax
  704.  
  705. *-----------------------------------------------------------------
  706.  
  707. static function ScrollNext(aGet,nGet,nLastget, Boxtop,Boxh,BGtop,Bgh)
  708. /*****************************************
  709. 0    11         ║
  710. 1    12  *      ║                   *:row = 1, *:cargo[CARGO_ROW]=12
  711. 2  1─13─────────╫────┐ Boxtop =2
  712. 3  2 14BGTOP=14 ║    │
  713. 4  3 15         ║    │  Boxh  =5
  714. 5  4 16BGbot=16 ║    │
  715. 6  5─17─────────╫────┘ Boxbot =6
  716. 7    18══#══════╝ BGh =18           #:row = 7, #:cargo[CARGO_ROW] = 18
  717. ******************************************/
  718. BGTop := BGtop-(aGet[nLastget]:cargo[CARGO_ROW]-aGet[nGet]:cargo[CARGO_ROW])
  719. BGTop := max(min(BGtop,BGh-Boxh+3),1)
  720. NewGetRows(aGet,Boxtop,Bgtop)
  721. return nil
  722.  
  723. *-----------------------------------------------------------------
  724.  
  725. function ShowGetBG(GetBG,Boxtop,Boxleft,Boxw,BGTOP,nLines,cColor)
  726. local cO_Color := setcolor(), nRow := Boxtop
  727. * the 6th Parameter is optional, default is the actual color
  728. if pcount() > 6
  729.    cO_color := setcolor(cColor)
  730. endif
  731. * GetBg is an array, where every element represents one line of the Background
  732. * now display those lines, wich fit into the frame
  733. * (see 3rd and 4th Parameter to aeval)
  734. * Doing this with aeval is much faster than a for next loop..
  735. aeval(GetBG,{|Line|devpos(++nRow,Boxleft+1),devout(padr(line,Boxw-2))},BGTop,nLines)
  736. setcolor(cO_color) // Reset the color setting
  737. return nil
  738.  
  739. *-----------------------------------------------------------------
  740.  
  741. // Next two functions interface between real screen coordinates and the
  742. // virtual ones..
  743.  
  744. static function NewGetRows(aGet,Boxtop,Bgtop)
  745. // Internaly (in cargo[CARGO_ROW]), we have virtual Rows for every Get.
  746. // Numbering starts with 1, So that the First virtual Row is Number 1,
  747. // the second 2 etc.
  748.  
  749. // This function is to update the "real" (i.e. Get:Row) Rows of the
  750. // getfield..
  751. // The real job, to find out how many lines to shift, has been done above
  752. // within the UDF ScrollNext()
  753. //
  754. // If you're using scrolling gets with funcky's window functions
  755. // place a call to NewGetCols and NewGetRows every time the window has
  756. // been moved
  757. local Shift := Boxtop-Bgtop+1
  758. aeval(aGet,{|oGet|oGet:Row := oGet:cargo[CARGO_ROW] + Shift})
  759.  
  760. /*
  761. * Above eval() should be equivalent to :
  762. for nKounter := 1 to len(aGet)
  763.    aGet[nKounter]:Row := aGet[nKounter]:cargo[CARGO_ROW] + Shift
  764. next
  765. */
  766. return nil
  767.  
  768. *-----------------------------------------------------------------
  769.  
  770. static function NewGetCols(aGet,Boxleft)
  771. // Internaly (in cargo[CARGO_COL]), we have virtual Columns for every Get.
  772. // Numbering starts with 0, So that the First virtual Column is Number 0,
  773. // the second 1 etc.
  774.  
  775. // This function is to update the "real" (i.e. Get:Col) Columns of the
  776. // getfield..
  777.  
  778. // We just add the left column of the Box (+1 for the frame)
  779. // to every Getcolumn.
  780. // As we don't expect the Box to shift and we don't implemented
  781. // horizontal scrolling, this has to be done only once (at startup time)
  782. //
  783. // If you're using scrolling gets with funcky's window functions
  784. // place a call to NewGetCols and NewGetRows every time the window has
  785. // been moved
  786.  
  787. local Shift := Boxleft+1
  788. *    1     CP    P     S    IS     S                        C1
  789. aeval(aGet,{|oGet| oGet:Col := oGet:cargo[CARGO_COL] + Shift})
  790. return nil
  791.  
  792. *-----------------------------------------------------------------
  793.  
  794. static function ShowGets(aGet,nGet,Boxtop,Boxh)
  795. local nKounter:=0
  796.  
  797. AEVAL(aGet, {|oGet|nKounter++,;
  798.      iif(oGet:Row>Boxtop .and. oGet:Row<Boxbot,;
  799.         iif(nKounter == nGet,;
  800.             GetFocus( oGet,.t.),;
  801.             oGet:display()),;
  802.       NIL)})
  803.  
  804. /*
  805. * I personaly use this numbering System, to check for bracket-related typos
  806. * within complex expressions (when I start getting confused) :
  807. 1      CP             P
  808. AEVAL(aGet, {|oGet,nKounter|nKounter++,;
  809.          2    S                                I1
  810.      iif(oGet:Row>Boxtop .and. oGet:Row<Boxbot,;
  811.             3                I2
  812.          iif(nKounter == nGet,;
  813.                      4         4 T2
  814.              GetFocus( oGet,.t.) ,;
  815.                          44 3 T1
  816.              oGet:display() ) ,;
  817.         2 C 1
  818.      NIL) } )
  819. */
  820.  
  821. /*
  822. ** The Aeval above should do the same job as the following Statements
  823. ** (only much faster)
  824. ** (I usualy write the Clipper S'87 code first before translating
  825. ** it to Clipper5's aeval()-Expressions)
  826. for nKounter := 1 to len(aGet)
  827.    // if the getfiled is within the frame
  828.    if aGet[nKounter]:Row > GetTRow .and. aGet[nKounter]:Row < GetBRow
  829.       // if it's the cative getfield
  830.       if nKounter == nGet
  831.          // Tell the getsystem
  832.          GetFocus(aGet[nKounter],.t.)
  833.       else
  834.          // otherwise display "only"
  835.          aGet[nKounter]:display()
  836.       endif
  837.    else
  838.       // If we know that the GetList  is ordered by Rows
  839.       // Rather the by colums or otherwise...
  840.       // We could place an "Exit"-Statement at this place..
  841.    endif
  842. next
  843. */
  844. return nil
  845.  
  846. *-----------------------------------------------------------------
  847.  
  848. *  Function GetFocus()
  849. *
  850. //  If lFocus is true the GET receives input focus
  851. //  If lFocus is false the GET's input focus is taken away.
  852. static FUNCTION GetFocus( oGetObj, lFocus)
  853.  
  854. IF lFocus
  855.    oGetObj:SETFOCUS()
  856.    //  Returns the cursor to the current Get
  857.    // DEVPOS( oGetObj:ROW, oGetObj:COL )
  858.  
  859. ELSE
  860.    oGetObj:KILLFOCUS()
  861. ENDIF
  862.  
  863. RETURN nil
  864.  
  865. *-----------------------------------------------------------------
  866.  
  867. // The next two functions are the Functions from Nantucket's Getsys.prg
  868. // to check When and Valid - Clauses...
  869.  
  870. /***
  871. * GetPreValidate()
  872. */
  873. static function GetPreValidate(get)
  874.  
  875. local when := .t.
  876.  
  877.  
  878.     if ( get:preBlock <> NIL )
  879.  
  880.         when := Eval(get:preBlock, get)
  881.  
  882.         get:Display()
  883.  
  884.     end
  885.  
  886. return (when)
  887.  
  888.  
  889. static function GetPostValidate(get)
  890.  
  891. local saveUpdated
  892. local changed, valid := .t.
  893.  
  894.     if ( get:BadDate() )
  895.         get:Home()
  896.       return (.f.)
  897.     end
  898.  
  899.  
  900.     if ( get:changed )
  901.         get:Assign()
  902.     end
  903.  
  904.     get:Reset()
  905.  
  906.     if ( get:postBlock <> NIL )
  907.  
  908.         // S87 compat.
  909.         SetPos( get:row, get:col + Len(get:buffer) )
  910.  
  911.         valid := Eval(get:postBlock, get)
  912.  
  913.         // reset compat. pos
  914.         SetPos( get:row, get:col )
  915.  
  916.         get:UpdateBuffer()
  917.  
  918.     end
  919.  
  920. return (valid)
  921.  
  922. *-----------------------------------------------------------------
  923.  
  924. function Shad( nTR, nTC, nBR, nBC, lDoub, cClrs )
  925. // Shad() used to be in Nantucket Canada's funs.ch file.
  926. // I transfered it to a function for easy use in codeblocks
  927.  
  928. local cDefCol:=SETCOLOR( IF( EMPTY( cClrs ), Nil, cClrs ) )
  929. SETCOLOR( 'w+/n' )
  930. dispBOX( nTR+1, nTC+2, nBR+1, nBC+2, '░░░░░░░░░' )
  931. SETCOLOR( cClrs )
  932. scroll( nTR, nTC, nBR, nBC,0)
  933. IF lDoub
  934.    dispbox( nTR, nTC, nBR, nBC, 2 )
  935. endif
  936. SETCOLOR( cDefCol )
  937. return nil
  938. *-----------------------------------------------------------------
  939.  
  940. // This last function pops up when the user is assumed to leave the gets
  941. // You can throw it out or replace it with your own function.
  942. // Non-english programs should at least translate the messages...
  943. //
  944. // it's also more or less from Nantucket Canada, especialy the nice 
  945. // Boxing/Shadowing functions used therein..
  946.  
  947. * * * *
  948. *
  949. *  Function TimeToExit()
  950. *
  951. //  Exit Dialog Box
  952. static FUNCTION TimeToExit()
  953. LOCAL cDefcol  // needed and initialized within BoxShad() (See Funcs.ch)
  954. local cDefColor := SETCOLOR( 'w+/r' )
  955. local cScrn := SAVESCREEN( 8, 30, 13, 54 )
  956. LOCAL nExitCh := 1
  957.  
  958. BoxShad( 8, 30, 12, 52, 'w+/r' )
  959.  
  960. if lastkey() == K_ESC
  961.    @9, 36 SAY  'Abort without'
  962.    @10,33 SAY 'Saving changes ?'
  963. else
  964.    @9, 36 SAY    'End Editing'
  965.    @10,33 say 'and save changes ?'
  966. endif
  967. @11, 36 PROMPT ' YES '
  968. @11, 42 PROMPT ' NO '
  969. MENU TO nExitCh
  970.  
  971. SETCOLOR( cDefColor )
  972. RESTSCREEN( 8, 30, 13, 54, cScrn )
  973.  
  974. RETURN nExitCh
  975.  
  976. ******
  977. * EOF
  978. ******